home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / EXECUTC1.MOD < prev    next >
Encoding:
Text File  |  1987-07-19  |  45.9 KB  |  1,233 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           Execute_Command --- Execute PibTerm  command               *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Execute_Command;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Execute_Command                                      *)
  10. (*                                                                      *)
  11. (*     Purpose:    Execute PibTerm Commands                             *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Execute_Command( VAR Command    : Pibterm_Command_Type;       *)
  16. (*                         VAR Done       : BOOLEAN;                    *)
  17. (*                             Use_Script : BOOLEAN );                  *)
  18. (*                                                                      *)
  19. (*           Command    --- Command to execute                          *)
  20. (*           Done       --- set TRUE if termination command found       *)
  21. (*           Use_Script --- TRUE if this is a script command execution  *)
  22. (*                                                                      *)
  23. (*      Calls:   Async_Send_String                                      *)
  24. (*               PibDialer                                              *)
  25. (*               Async_Send_Break                                       *)
  26. (*               Async_Carrier_Detect                                   *)
  27. (*               Display_Commands                                       *)
  28. (*               Delay                                                  *)
  29. (*               GetAreaCode                                            *)
  30. (*               PibUpLoad                                              *)
  31. (*               PibDownLoad                                            *)
  32. (*               Save_Screen                                            *)
  33. (*               Restore_Screen                                         *)
  34. (*               Draw_Menu_Frame                                        *)
  35. (*               Fast_Change_Params                                     *)
  36. (*               PibFileManipulation                                    *)
  37. (*               Get_Capture_File                                       *)
  38. (*               Toggle_Option                                          *)
  39. (*               HangUpPhone                                            *)
  40. (*               Send_Function_Key                                      *)
  41. (*               Set_Input_Keys                                         *)
  42. (*               Set_Translate_Table                                    *)
  43. (*               Do_Screen_Dump                                         *)
  44. (*               DosJump                                                *)
  45. (*               Handle_Function_Key                                    *)
  46. (*                                                                      *)
  47. (*----------------------------------------------------------------------*)
  48.  
  49. VAR
  50.    Flag       : BOOLEAN;
  51.    I          : INTEGER;
  52.    J          : INTEGER;
  53.    T_Type     : Terminal_Type;
  54.    TimeW      : STRING[8];
  55.    TimeN      : STRING[8];
  56.    TimeO      : STRING[8];
  57.    Local_Save : Saved_Screen_Ptr;
  58.    ESC_Found  : BOOLEAN;
  59.    Trans_Type : Transfer_Type;
  60.    Ch         : CHAR;
  61.    Rem_Ch     : CHAR;
  62.    XPos       : INTEGER;
  63.    GotChar    : BOOLEAN;
  64.    S          : AnyStr;
  65.    Echo       : BOOLEAN;
  66.    Test_Cond  : BOOLEAN;
  67.    File_Done  : BOOLEAN;
  68.    Do_Editing : BOOLEAN;
  69.    Do_Viewing : BOOLEAN;
  70.    F          : FILE;
  71.    Alter_Status : BOOLEAN;
  72.  
  73. VAR
  74.    Save_Do_Status_Line : BOOLEAN;
  75.  
  76. (* STRUCTURED *) CONST
  77.    Oper_Type_Vector : ARRAY[0..MaxOperandTypes] OF OperandType =
  78.                       ( Bad_Operand_Type, Operator_Type, Integer_Variable_Type,
  79.                         Real_Variable_Type, String_Variable_Type,
  80.                         Integer_Constant_Type, Real_Constant_Type,
  81.                         String_Constant_Type,
  82.                         StackEnd_Type, Left_Paren_Type, Right_Paren_Type );
  83.  
  84. LABEL
  85.    LAddLFSy,        LAlarmSy,       LAreaCodeSy,    LBreakSy,
  86.    LCallSy,         LCaptureSy,     LChDirSy,       LClearSy,
  87.    LCloseSy,        LClrEolSy,      LCommFlushSy,   LDeclareSy,
  88.    LDelaySy,        LDelLineSy,     LDialSy,        LDosSy,
  89.    LEchoSy,         LEditSy,        LExecuteSy,     LExeNewSy,
  90.    LExitSy,         LExitAllSy,     LFastCSy,       LFileSy,
  91.    LGetDirSy,       LGetParamSy,    LGetVarSy,      LGossipSy,
  92.    LGoToSy,         LGoToXYSy,      LHangUpSy,      LHostSy,
  93.    LIfConSy,        LIfDialSy,      LIfEofSy,       LIfExistsSy,
  94.    LIfFoundSy,      LIfLocStrSy,    LIfOkSy,        LIfOpSy,
  95.    LIfRemStrSy,     LImportSy,      LInfoSy,        LInputSy,
  96.    LInsLineSy,      LKeyDefSy,      LKeyFlushSy,    LKeySendSy,
  97.    LKeySy,          LLogSy,         LMenuSy,        LMessageSy,
  98.    LMuteSy,
  99.    LOpenSy,         LParamSy,       LPImportSy,     LQuitSy,
  100.    LReadSy,         LReadLnSy,      LReceiveSy,     LReDialSy,
  101.    LResetSy,        LReturnSy,      LRInputSy,      LScriptSy,
  102.    LSDumpSy,        LSendSy,        LSetSy,         LSetVarSy,
  103.    LSTextSy,
  104.    LTextSy,         LTimersSy,      LTranslateSy,   LViewSy,
  105.    LWaitSy,         LWhereXYSy,     LWriteSy,       LWriteLnSy,
  106.    LWriteLogSy,     LZapVarSy,      LSetParamSy,
  107.    LEndCase;
  108.  
  109. {
  110.  
  111. PROCEDURE Debug_Write( S : AnyStr );
  112.  
  113. BEGIN (* Debug_Write *)
  114.  
  115.    Write_Log( S , FALSE );
  116.  
  117. END   (* Debug_Write *);
  118.  
  119. FUNCTION ITOS( I: INTEGER ) : AnyStr;
  120.  
  121. VAR
  122.    S: STRING[10];
  123.  
  124. BEGIN (* ITOS *)
  125.  
  126.    STR( I , S );
  127.    ITOS := S;
  128.  
  129. END   (* ITOS *);
  130.  
  131. }
  132.  
  133. (*----------------------------------------------------------------------*)
  134. (*           Remote_Input --- get remote input in response to prompt    *)
  135. (*----------------------------------------------------------------------*)
  136.  
  137. PROCEDURE Remote_Input;
  138.  
  139. (*----------------------------------------------------------------------*)
  140. (*                                                                      *)
  141. (*     Procedure:  Remote_Input                                         *)
  142. (*                                                                      *)
  143. (*     Purpose:    Gets remote input (from host system) in response to  *)
  144. (*                 prompt.                                              *)
  145. (*                                                                      *)
  146. (*     Calling Sequence:                                                *)
  147. (*                                                                      *)
  148. (*        Remote_Input;                                                 *)
  149. (*                                                                      *)
  150. (*           Global string  -Script_Remote_Reply- get the resultant     *)
  151. (*           input.                                                     *)
  152. (*                                                                      *)
  153. (*      Calls:   Async_Send                                             *)
  154. (*               Send_Function_Key                                      *)
  155. (*               Async_Receive                                          *)
  156. (*                                                                      *)
  157. (*----------------------------------------------------------------------*)
  158.  
  159. VAR
  160.    Rem_Ch     : CHAR;
  161.    XPos       : INTEGER;
  162.    GotChar    : BOOLEAN;
  163.    S          : AnyStr;
  164.    Echo       : BOOLEAN;
  165.    Ch         : CHAR;
  166.  
  167. BEGIN (* Remote_Input *)
  168.                                    (* Send prompt to remote system *)
  169.  
  170.    IF LENGTH( Script_String ) > 0 THEN
  171.       Send_Function_Key( Read_Ctrls( Script_String ) );
  172.  
  173.    Ch                     := CHR( 0 );
  174.    Script_Remote_Reply[0] := CHR( 0 );
  175.    XPos                   := WhereX;
  176.    Echo                   := ( Script_Integer_1 > 0 );
  177.  
  178.                                    (* Get response string        *)
  179.    REPEAT
  180.  
  181.       GotChar := FALSE;
  182.                                    (* Check for keyboard input   *)
  183.       IF KeyPressed THEN
  184.          BEGIN
  185.             READ( Kbd, Ch );
  186.             GotChar := TRUE;
  187.          END;
  188.                                    (* Check for remote input *)
  189.  
  190.       IF Async_Receive( Rem_Ch ) THEN
  191.          BEGIN
  192.             Ch      := Rem_Ch;
  193.             GotChar := TRUE;
  194.          END;
  195.                                    (* Process received character *)
  196.       IF GotChar THEN
  197.          IF Ch <> CHR( CR ) THEN
  198.             IF Ch = ^H THEN
  199.                BEGIN  (* Backspace *)
  200.                   IF WhereX > Xpos THEN
  201.                      BEGIN
  202.                         Async_Send( Ch  );
  203.                         WRITE( Ch );
  204.                         Async_Send( ' ' );
  205.                         WRITE( ' ' );
  206.                         Async_Send( Ch  );
  207.                         WRITE( Ch );
  208.                         IF ( LENGTH( Script_Remote_Reply ) > 1 ) THEN
  209.                            Script_Remote_Reply := COPY( Script_Remote_Reply,
  210.                                                   1,
  211.                                                   LENGTH( Script_Remote_Reply ) - 1 )
  212.                         ELSE
  213.                            Script_Remote_Reply[0] := CHR( 0 );
  214.                      END;
  215.                END   (* Backspace *)
  216.             ELSE
  217.                BEGIN
  218.                   Script_Remote_Reply := Script_Remote_Reply + Ch;
  219.                   IF Echo THEN
  220.                      BEGIN
  221.                         Async_Send( Ch );
  222.                         WRITE( Ch );
  223.                      END
  224.                   ELSE
  225.                      BEGIN
  226.                         Async_Send( '.' );
  227.                         WRITE( '.' );
  228.                      END
  229.                END;
  230.  
  231.    UNTIL ( Ch = CHR( CR ) ) OR ( NOT Async_Carrier_Detect );
  232.  
  233.    Script_Remote_Reply_Ok := FALSE;
  234.  
  235.                                    (* Copy to variable if necessary *)
  236.  
  237.    IF ( Script_Integer_2 > 2 ) THEN
  238.       Script_Variables^[Script_Integer_2].Var_Value^ :=
  239.          Script_Remote_Reply;
  240.  
  241. END   (* Remote_Input *);
  242.  
  243. (*----------------------------------------------------------------------*)
  244. (*           Execute_Stack --- Execute postfix command stack            *)
  245. (*----------------------------------------------------------------------*)
  246.  
  247. PROCEDURE Execute_Stack( Result_Index : INTEGER );
  248.  
  249. VAR
  250.    Stack         : ARRAY[1..MaxExecStack] OF Stack_Entry_Ptr;
  251.    End_Of_Stack  : BOOLEAN;
  252.    Stack_Index   : INTEGER;
  253.    Operand_Type  : INTEGER;
  254.    Index         : INTEGER;
  255.    Var_Ptr       : Stack_Entry_Ptr;
  256.    IVal          : INTEGER;
  257.    Int1          : INTEGER;
  258.    Str1          : AnyStr;
  259.    Int1_Bytes    : ARRAY[1..2] OF BYTE ABSOLUTE Int1;
  260.  
  261. (*----------------------------------------------------------------------*)
  262. (*     Move_Variable_To_Stack --- Place variable on evaluation stack    *)
  263. (*----------------------------------------------------------------------*)
  264.  
  265. PROCEDURE Move_Variable_To_Stack( Index : INTEGER );
  266.  
  267. VAR
  268.    IType : OperandType;
  269.  
  270. BEGIN (* Move_Variable_To_Stack *)
  271.  
  272.    Stack_Index := SUCC( Stack_Index );
  273.  
  274.    NEW( Stack[Stack_Index] );
  275.                                    (* Defines a script record *)
  276.  
  277.    IType                      := Script_Variables^[Index].Var_Type;
  278.    Stack[Stack_Index]^.TypVal := IType;
  279.  
  280.    CASE IType OF
  281.       Integer_Variable_Type: MOVE( Script_Variables^[Index].Var_Value^[1],
  282.                                    Stack[Stack_Index]^.IntVal, 2 );
  283.       String_Variable_Type : Stack[Stack_Index]^.StrVal := Script_Variables^[Index].Var_Value^;
  284.    END (* CASE *);
  285.  
  286. END   (* Move_Variable_To_Stack *);
  287.  
  288. (*----------------------------------------------------------------------*)
  289. (* Move_Integer_Constant_To_Stack --- Place integer on evaluation stack *)
  290. (*----------------------------------------------------------------------*)
  291.  
  292. PROCEDURE Move_Integer_Constant_To_Stack( IntVal : INTEGER );
  293.  
  294. BEGIN (* Move_Integer_Constant_To_Stack *)
  295.  
  296.    Stack_Index := SUCC( Stack_Index );
  297.  
  298.    NEW( Stack[Stack_Index] );
  299.  
  300.    Stack[Stack_Index]^.TypVal := Integer_Variable_Type;
  301.    Stack[Stack_Index]^.IntVal := IntVal;
  302.  
  303. END   (* Move_Integer_Constant_To_Stack *);
  304.  
  305. (*----------------------------------------------------------------------*)
  306. (* Move_String_Constant_To_Stack --- Place string on evaluation stack   *)
  307. (*----------------------------------------------------------------------*)
  308.  
  309. PROCEDURE Move_String_Constant_To_Stack( VAR Index : INTEGER );
  310.  
  311. VAR
  312.    L : INTEGER;
  313.  
  314. BEGIN (* Move_String_Constant_To_Stack *)
  315.  
  316.    Stack_Index := SUCC( Stack_Index );
  317.  
  318.    NEW( Stack[Stack_Index] );
  319.  
  320.    L := Script_Buffer^[Index];
  321.  
  322.    MOVE( Script_Buffer^[Index+1], Stack[Stack_Index]^.StrVal[1], L );
  323.  
  324.    Stack[Stack_Index]^.StrVal[0] := CHR( L );
  325.    Stack[Stack_Index]^.TypVal    := String_Variable_Type;
  326.  
  327.    Index := Index + L;
  328. {
  329. IF Debug_Mode THEN
  330.    Debug_Write('===> Moving <' + Stack[Stack_Index]^.StrVal + '> onto stack.');
  331. }
  332. END   (* Move_String_Constant_To_Stack *);
  333.  
  334. (*----------------------------------------------------------------------*)
  335. (*       Pop_Stack_Integer --- Remove integer from evaluation stack     *)
  336. (*----------------------------------------------------------------------*)
  337.  
  338. PROCEDURE Pop_Stack_Integer( VAR IntVal : INTEGER );
  339.  
  340. BEGIN (* Pop_Stack_Integer *)
  341.  
  342.    IntVal := Stack[Stack_Index]^.IntVal;
  343.  
  344.    DISPOSE( Stack[Stack_Index] );
  345.  
  346.    Stack_Index := PRED( Stack_Index );
  347.  
  348. END   (* Pop_Stack_Integer *);
  349.  
  350. (*----------------------------------------------------------------------*)
  351. (*       Pop_Stack_String --- Remove string from evaluation stack       *)
  352. (*----------------------------------------------------------------------*)
  353.  
  354. PROCEDURE Pop_Stack_String( VAR StrVal : AnyStr );
  355.  
  356. BEGIN (* Pop_Stack_String *)
  357.  
  358.    StrVal := Stack[Stack_Index]^.StrVal;
  359.  
  360.    DISPOSE( Stack[Stack_Index] );
  361.  
  362.    Stack_Index := PRED( Stack_Index );
  363.  
  364. END   (* Pop_Stack_String *);
  365.  
  366. (*----------------------------------------------------------------------*)
  367. (*       Perform_Operator --- Execute operator using evaluation stack   *)
  368. (*----------------------------------------------------------------------*)
  369.  
  370. PROCEDURE Perform_Operator( Operator : OperType );
  371.  
  372. VAR
  373.    Int1: INTEGER;
  374.    Int2: INTEGER;
  375.    Str1: AnyStr;
  376.    Str2: AnyStr;
  377.    Str3: AnyStr;
  378.    IRes: INTEGER;
  379.    SRes: AnyStr;
  380.    I   : INTEGER;
  381.  
  382.    Int1_Bytes : ARRAY[1..2] OF BYTE ABSOLUTE Int1;
  383.  
  384. TYPE
  385.    ArgType = ( One_String, One_Integer, Two_Integers, Two_Strings,
  386.                String_And_One_Integer, String_And_Two_Integers,
  387.                Special_Args, No_Args );
  388.  
  389. (* STRUCTURED *) CONST
  390.    ArgTypeVector : ARRAY[OperType] OF ArgType =
  391.                    ( Special_Args, Two_Integers, Two_Integers, Two_Integers,
  392.                      Two_Integers, Two_Integers, Two_Integers, Two_Integers,
  393.                      Two_Integers, Two_Integers, Two_Integers,
  394.                      Two_Strings,  Two_Strings,  Two_Strings,
  395.                      Two_Strings,  Two_Strings,  Two_Strings,
  396.                      Two_Integers,
  397.                      One_Integer,  Two_Integers, Two_Integers,
  398.                      String_And_Two_Integers, Two_Strings, One_String,
  399.                      Two_Strings, No_Args, No_Args, One_Integer,
  400.                      One_String, No_Args, One_String , One_Integer ,
  401.                      No_Args, String_And_One_Integer, One_String, One_String,
  402.                      No_Args, One_Integer, No_Args, No_Args, One_String,
  403.                      No_Args, No_Args, One_Integer, String_And_One_Integer,
  404.                      One_Integer, One_String, One_String );
  405.  
  406.    ResTypeVector : ARRAY[OperType] OF OperandType =
  407.                    ( Bad_Operand_Type,
  408.                      Integer_Variable_Type, Integer_Variable_Type,
  409.                      Integer_Variable_Type, Integer_Variable_Type,
  410.                      Integer_Variable_Type, Integer_Variable_Type,
  411.                      Integer_Variable_Type, Integer_Variable_Type,
  412.                      Integer_Variable_Type, Integer_Variable_Type,
  413.                      Integer_Variable_Type, Integer_Variable_Type,
  414.                      Integer_Variable_Type, Integer_Variable_Type,
  415.                      Integer_Variable_Type, Integer_Variable_Type,
  416.                      Integer_Variable_Type, Integer_Variable_Type,
  417.                      Integer_Variable_Type, Integer_Variable_Type,
  418.                      String_Variable_Type,  Integer_Variable_Type,
  419.                      Integer_Variable_Type, String_Variable_Type,
  420.                      Integer_Variable_Type, Integer_Variable_Type,
  421.                      String_Variable_Type,  Integer_Variable_Type,
  422.                      Integer_Variable_Type, Integer_Variable_Type,
  423.                      Integer_Variable_Type, Integer_Variable_Type,
  424.                      String_Variable_Type,  String_Variable_Type,
  425.                      String_Variable_Type,  Integer_Variable_Type,
  426.                      String_Variable_Type,  String_Variable_Type,
  427.                      Integer_Variable_Type, String_Variable_Type,
  428.                      String_Variable_Type,  String_Variable_Type,
  429.                      String_Variable_Type,  Integer_Variable_Type,
  430.                      String_Variable_Type,  String_Variable_Type,
  431.                      String_Variable_Type );
  432.  
  433. LABEL
  434.    LNoOpSy,          LAddSy,        LSubtractSy,    LMultSy,       LDivideSy,
  435.    LEqualISy,        LLessISy,      LLessEqualISy,  LGreaterISy,   LGreaterEqualISy,
  436.    LNotEqualISy,     LEqualSSy,     LLessSSy,       LLessEqualSSy, LGreaterSSy,
  437.    LGreaterEqualSSy, LNotEqualSSy,  LAndSy,         LNotSy,        LOrSy,
  438.    LXorSy,           LSubStrSy,     LIndexSy,       LLengthSy,     LConcatSy,
  439.    LConnectedSy,     LWaitFoundSy,  LStringSy,      LNumberSy,     LAttendedSy,
  440.    LFileExistsSy,    LEofSy,        LIOResultSy,    LDuplSy,       LUpperCaseSy,
  441.    LTrimSy,          LParamCountSy, LParamStrSy,    LParamLineSy,  LDialedSy,
  442.    LLTrimSy,         LDateSy,       LTimeSy,        LDialEntrySy,  LOrdSy,
  443.    LChrSy,           LReadCtrlSy,   LWriteCtrlSy,   LEndCase;
  444.  
  445. (*----------------------------------------------------------------------*)
  446. (*    Push_Stack_Integer --- Push integer value onto evaluation stack   *)
  447. (*----------------------------------------------------------------------*)
  448.  
  449. PROCEDURE Push_Stack_Integer( IntVal : INTEGER );
  450.  
  451. BEGIN (* Push_Stack_Integer *)
  452.  
  453.    Stack_Index := SUCC( Stack_Index );
  454.  
  455.    NEW( Stack[Stack_Index] );
  456.  
  457.    Stack[Stack_Index]^.TypVal := Integer_Variable_Type;
  458.  
  459.    Stack[Stack_Index]^.IntVal := IntVal;
  460.  
  461. END   (* Push_Stack_Integer *);
  462.  
  463. (*----------------------------------------------------------------------*)
  464. (*    Push_Stack_String --- Push string value onto evaluation stack     *)
  465. (*----------------------------------------------------------------------*)
  466.  
  467. PROCEDURE Push_Stack_String( StrVal : AnyStr );
  468.  
  469. BEGIN (* Push_Stack_String *)
  470.  
  471.    Stack_Index := SUCC( Stack_Index );
  472.  
  473.    NEW( Stack[Stack_Index] );
  474.  
  475.    Stack[Stack_Index]^.TypVal := String_Variable_Type;
  476.  
  477.    Stack[Stack_Index]^.StrVal := StrVal;
  478. {
  479. IF Debug_Mode THEN
  480.    Debug_Write('===> Pushing <' + StrVal + '> onto stack.');
  481. }
  482. END   (* Push_Stack_String *);
  483.  
  484. (*----------------------------------------------------------------------*)
  485.  
  486. BEGIN (* Perform_Operator *)
  487.  
  488.    CASE ArgTypeVector[Operator] OF
  489.       One_String              :  Pop_Stack_String ( Str1 );
  490.       One_Integer             :  Pop_Stack_Integer( Int1 );
  491.       Two_Integers            :  BEGIN
  492.                                     Pop_Stack_Integer( Int2 );
  493.                                     Pop_Stack_Integer( Int1 );
  494.                                  END;
  495.       Two_Strings             :  BEGIN
  496.                                     Pop_Stack_String ( Str2 );
  497.                                     Pop_Stack_String ( Str1 );
  498.                                  END;
  499.       String_And_One_Integer  :  BEGIN
  500.                                     Pop_Stack_Integer( Int1 );
  501.                                     Pop_Stack_String ( Str1 );
  502.                                  END;
  503.       String_And_Two_Integers :  BEGIN
  504.                                     Pop_Stack_Integer( Int2 );
  505.                                     Pop_Stack_Integer( Int1 );
  506.                                     Pop_Stack_String ( Str1 );
  507.                                  END;
  508.       ELSE;
  509.    END;
  510.  
  511. {  CASE Operator OF }
  512.                                    (* Use jump table to avoid time-consuming *)
  513.                                    (* CASE statement.                        *)
  514.    I := ORD( Operator );
  515.  
  516.    INLINE(
  517.      $8B/$9E/>I             {  MOV     BX,[BP+>I]         ;Pick up ORD(Operator)}
  518.      /$89/$D8               {  MOV     AX,BX              ;Command}
  519.      /$D1/$E3               {  SHL     BX,1               ;Command * 2}
  520.      /$01/$C3               {  ADD     BX,AX              ;Command * 3}
  521.      /$B8/>*+6              {  MOV     AX,>*+6            ;Address of first GOTO}
  522.      /$01/$C3               {  ADD     BX,AX              ;Add offset of command}
  523.      /$FF/$E3               {  JMP     BX                 ;Branch to proper GOTO}
  524.    );
  525.  
  526.       GOTO LNoOpSy;
  527.       GOTO LAddSy;
  528.       GOTO LSubtractSy;
  529.       GOTO LMultSy;
  530.       GOTO LDivideSy;
  531.       GOTO LEqualISy;
  532.       GOTO LLessISy;
  533.       GOTO LLessEqualISy;
  534.       GOTO LGreaterISy;
  535.       GOTO LGreaterEqualISy;
  536.       GOTO LNotEqualISy;
  537.       GOTO LEqualSSy;
  538.       GOTO LLessSSy;
  539.       GOTO LLessEqualSSy;
  540.       GOTO LGreaterSSy;
  541.       GOTO LGreaterEqualSSy;
  542.       GOTO LNotEqualSSy;
  543.       GOTO LAndSy;
  544.       GOTO LNotSy;
  545.       GOTO LOrSy;
  546.       GOTO LXorSy;
  547.       GOTO LSubStrSy;
  548.       GOTO LIndexSy;
  549.       GOTO LLengthSy;
  550.       GOTO LConcatSy;
  551.       GOTO LConnectedSy;
  552.       GOTO LWaitFoundSy;
  553.       GOTO LStringSy;
  554.       GOTO LNumberSy;
  555.       GOTO LAttendedSy;
  556.       GOTO LFileExistsSy;
  557.       GOTO LEofSy;
  558.       GOTO LIOResultSy;
  559.       GOTO LDuplSy;
  560.       GOTO LUpperCaseSy;
  561.       GOTO LTrimSy;
  562.       GOTO LParamCountSy;
  563.       GOTO LParamStrSy;
  564.       GOTO LParamLineSy;
  565.       GOTO LDialedSy;
  566.       GOTO LLTrimSy;
  567.       GOTO LDateSy;
  568.       GOTO LTimeSy;
  569.       GOTO LDialEntrySy;
  570.       GOTO LOrdSy;
  571.       GOTO LChrSy;
  572.       GOTO LReadCtrlSy;
  573.       GOTO LWriteCtrlSy;
  574.  
  575.       LNoOpSy  : ;
  576.                         GOTO LEndCase;
  577.       LAddSy:           IRes := Int1 + Int2;
  578.                         GOTO LEndCase;
  579.       LSubtractSy:      IRes := Int1 - Int2;
  580.                         GOTO LEndCase;
  581.       LMultSy:          IRes := Int1 * Int2;
  582.                         GOTO LEndCase;
  583.       LDivideSy:        IF ( Int2 <> 0 ) THEN
  584.                            IRes := Int1 DIV Int2
  585.                         ELSE
  586.                            IRes := 0;
  587.                         GOTO LEndCase;
  588.       LConcatSy:        BEGIN
  589.                            IRes := ORD( Str1[0] ) + ORD( Str2[0] );
  590.                            IF ( IRes <= 255 ) THEN
  591.                               SRes := Str1 + Str2
  592.                            ELSE
  593.                               SRes := Str1 + Substr( Str2, 1, 255 - ORD( Str1[0] ) );
  594.                         END;
  595.                         GOTO LEndCase;
  596.       LSubStrSy:        SRes := Substr( Str1, Int1, Int2 );
  597.                         GOTO LEndCase;
  598.       LIndexSy:         IRes := POS( Str1, Str2 );
  599.                         GOTO LEndCase;
  600.       LLengthSy:        IRes := ( ORD( Str1[0] ) );
  601.                         GOTO LEndCase;
  602.       LEqualISy:        IRes := ORD( Int1 = Int2 );
  603.                         GOTO LEndCase;
  604.       LLessEqualISy:    IRes := ORD( Int1 <= Int2 );
  605.                         GOTO LEndCase;
  606.       LLessISy:         IRes := ORD( Int1 < Int2 );
  607.                         GOTO LEndCase;
  608.       LGreaterISy:      IRes := ORD( Int1 > Int2 );
  609.                         GOTO LEndCase;
  610.       LGreaterEqualISy: IRes := ORD( Int1 >= Int2 );
  611.                         GOTO LEndCase;
  612.       LNotEqualISy    : IRes := ORD( Int1 <> Int2 );
  613.                         GOTO LEndCase;
  614.       LEqualSSy:        IRes := ORD( CompareStr( Str1 , Str2 ) =  Equal    );
  615.                         GOTO LEndCase;
  616.       LLessEqualSSy:    IRes := ORD( CompareStr( Str1 , Str2 ) <> Greater  );
  617.                         GOTO LEndCase;
  618.       LLessSSy:         IRes := ORD( CompareStr( Str1 , Str2 ) =  Less     );
  619.                         GOTO LEndCase;
  620.       LGreaterSSy:      IRes := ORD( CompareStr( Str1 , Str2 ) =  Greater  );
  621.                         GOTO LEndCase;
  622.       LGreaterEqualSSy: IRes := ORD( CompareStr( Str1 , Str2 ) <> Less     );
  623.                         GOTO LEndCase;
  624.       LNotEqualSSy    : IRes := ORD( CompareStr( Str1 , Str2 ) <> Equal    );
  625.                         GOTO LEndCase;
  626.       LAndSy          : IRes := Int1 AND Int2;
  627.                         GOTO LEndCase;
  628.       LNotSy          : IRes := NOT Int1;
  629.                         GOTO LEndCase;
  630.       LOrSy           : IRes := Int1 OR Int2;
  631.                         GOTO LEndCase;
  632.       LXorSy          : IRes := Int1 XOR Int2;
  633.                         GOTO LEndCase;
  634.       LOrdSy          : IRes := ORD( Str1[ Int1 ] );
  635.                         GOTO LEndCase;
  636.       LChrSy          : SRes := CHR( Int1 );
  637.                         GOTO LEndCase;
  638.       LWaitFoundSy    : IRes := ORD( Script_Wait_Found    );
  639.                         GOTO LEndCase;
  640.       LConnectedSy    : IRes := ORD( Async_Carrier_Detect );
  641.                         GOTO LEndCase;
  642.       LAttendedSy     : IRes := ORD( Attended_Mode );
  643.                         GOTO LEndCase;
  644.       LDialedSy       : IRes := ORD( Script_Dialed );
  645.                         GOTO LEndCase;
  646.       LFileExistsSy   : BEGIN
  647.                               (*$I-*)
  648.                            ASSIGN( F , Str1 );
  649.                            RESET ( F );
  650.                               (*$I+*)
  651.                            IRes := ORD( Int24Result = 0 );
  652.                               (*$I-*)
  653.                            CLOSE ( F );
  654.                               (*$I+*)
  655.                            Int1 := Int24Result;
  656.                         END;
  657.                         GOTO LEndCase;
  658.       LEofSy          : BEGIN
  659.                            IF Script_File_Used[Int1] THEN
  660.                               IRes := ORD( Script_File_List[Int1]^.EOF_Seen )
  661.                            ELSE
  662.                               IRes := 1;
  663.                         END;
  664.                         GOTO LEndCase;
  665.       LStringSy       : STR( Int1 , SRes );
  666.                         GOTO LEndCase;
  667.       LNumberSy       : BEGIN
  668.                            VAL( TRIM( LTRIM( Str1 ) ), IRes, Int1 );
  669.                            IF ( Int1 <> 0 ) THEN
  670.                               IRes := 0;
  671.                         END;
  672.                         GOTO LEndCase;
  673.       LIOResultSy     : IRes := Script_IO_Error;
  674.                         GOTO LEndCase;
  675.       LDuplSy         : SRes := Dupl( Str1[1], Int1 );
  676.                         GOTO LEndCase;
  677.       LUpperCaseSy    : SRes := UpperCase( Str1 );
  678.                         GOTO LEndCase;
  679.       LTrimSy         : SRes := Trim( Str1 );
  680.                         GOTO LEndCase;
  681.       LLTrimSy        : SRes := LTrim( Str1 );
  682.                         GOTO LEndCase;
  683.       LParamCountSy   : IRes := ParamCount;
  684.                         GOTO LEndCase;
  685.       LParamStrSy     : SRes := ParamStr( Int1 );
  686.                         GOTO LEndCase;
  687.       LParamLineSy    : MOVE( MEM[CSeg:$80], SRes, MEM[CSeg:$80] );
  688.                         GOTO LEndCase;
  689.       LDateSy         : SRes := DialDateString;
  690.                         GOTO LEndCase;
  691.       LTimeSy         : SRes := TimeString( TimeOfDay , Military_Time );
  692.                         GOTO LEndCase;
  693.       LDialEntrySy    : IF ( ( Int1 > 0 ) AND ( Int1 <= Dialing_Dir_Size ) ) THEN
  694.                            BEGIN
  695.                               SRes[0] := CHR( Dialing_Dir_Entry_Length );
  696.                               MOVE( Dialing_Directory^[Int1], SRes[1],
  697.                                     Dialing_Dir_Entry_Length );
  698.                            END
  699.                         ELSE
  700.                            SRes[0] := #0;
  701.                         GOTO LEndCase;
  702.       LReadCtrlSy     : SRes := Read_Ctrls ( Str1 );
  703.                         GOTO LEndCase;
  704.       LWriteCtrlSy    : SRes := Write_Ctrls( Str1 );
  705.                         GOTO LEndCase;
  706.  
  707. {  END (* CASE *); }
  708. LEndCase: ;
  709.  
  710.    CASE ResTypeVector[Operator] OF
  711.       Integer_Variable_Type:  Push_Stack_Integer( IRes );
  712.       String_Variable_Type :  Push_Stack_String ( SRes );
  713.       ELSE;
  714.    END (* CASE *);
  715.  
  716. END   (* Perform_Operator *);
  717.  
  718. (*----------------------------------------------------------------------*)
  719. (*       Get_Next_Operand --- Get next operand from postfix string      *)
  720. (*----------------------------------------------------------------------*)
  721.  
  722. PROCEDURE Get_Next_Operand( VAR Operand_Type : INTEGER;
  723.                             VAR Index        : INTEGER  );
  724.  
  725. BEGIN (* Get_Next_Operand *)
  726.  
  727.    Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  728.  
  729.    Operand_Type := Script_Buffer^[Script_Buffer_Pos];
  730.  
  731.    CASE Operands[Operand_Type] OF
  732.  
  733.       Operator_Type,
  734.       Integer_Variable_Type,
  735.       String_Variable_Type:  BEGIN
  736.                                 Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  737.                                 Index := Script_Buffer^[Script_Buffer_Pos];
  738.                              END;
  739.  
  740.       Integer_Constant_Type: BEGIN
  741.                                 Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  742.                                 MOVE( Script_Buffer^[Script_Buffer_Pos], Index, 2 );
  743.                                 Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  744.                              END;
  745.  
  746.       String_Constant_Type:  Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  747.  
  748.    END (* CASE *);
  749.  
  750. END   (* Get_Next_Operand *);
  751.  
  752. (*----------------------------------------------------------------------*)
  753.  
  754. BEGIN (* Execute_Stack *)
  755. {
  756.    IF Debug_Mode THEN
  757.       Debug_Write('+++ Entering Execute_Stack +++');
  758. }
  759.    End_Of_Stack := FALSE;
  760.    Stack_Index  := 0;
  761.  
  762.    WHILE ( NOT End_Of_Stack ) DO
  763.       BEGIN
  764.  
  765.          Get_Next_Operand( Operand_Type , Index );
  766.  
  767.          CASE Operands[Operand_Type] OF
  768.  
  769.             Integer_Variable_Type,
  770.             String_Variable_Type :  Move_Variable_To_Stack( Index );
  771.  
  772.             Integer_Constant_Type:  Move_Integer_Constant_To_Stack( Index );
  773.  
  774.             String_Constant_Type :  Move_String_Constant_To_Stack ( Script_Buffer_Pos );
  775.  
  776.             Operator_Type        :  Perform_Operator( OperSyms2[Index] );
  777.  
  778.             StackEnd_Type        :  End_Of_Stack := TRUE;
  779.  
  780.          END (* CASE *);
  781.  
  782.       END;
  783.  
  784.    WITH Script_Variables^[Result_Index] DO
  785.       BEGIN
  786.          CASE Var_Type OF
  787.             Integer_Variable_Type : BEGIN
  788.                                        Pop_Stack_Integer( Int1 );
  789.                                        Var_Value^ := CHR( Int1_Bytes[1] ) +
  790.                                                      CHR( Int1_Bytes[2] );
  791.                                     END;
  792.             String_Variable_Type  : BEGIN
  793.                                        Pop_Stack_String( Str1 );
  794.                                        Var_Value^ := Str1;
  795.                                     END;
  796.             ELSE
  797. {
  798.                IF Debug_Mode THEN
  799.                   Debug_Write('*** BOGUS RESULT MODE IN EXECUTE_STACK = ' +
  800.                               ITOS( ORD( Var_Type ) ) );
  801. }
  802.                ;
  803.          END (* CASE *);
  804.       END;
  805. {
  806.    IF Debug_Mode THEN
  807.       Debug_Write('+++ Leaving Execute_Stack +++');
  808. }
  809. END   (* Execute_Stack *);
  810.  
  811. (*----------------------------------------------------------------------*)
  812.  
  813. PROCEDURE Do_Simple_If( Condit : BOOLEAN );
  814.  
  815. BEGIN (* Do_Simple_If *)
  816.  
  817.    IF ( Script_Integer_1 = 1 ) THEN
  818.       IF Condit THEN
  819.          Script_Buffer_Pos := PRED( Script_Integer_2 )
  820.       ELSE
  821.          Script_Buffer_Pos := PRED( Script_Integer_3 )
  822.    ELSE
  823.       IF ( NOT Condit ) THEN
  824.          Script_Buffer_Pos := PRED( Script_Integer_2 )
  825.       ELSE
  826.          Script_Buffer_Pos := PRED( Script_Integer_3 );
  827.  
  828. END   (* Do_Simple_If *);
  829.  
  830. (*--------------------------------------------------------------------------*)
  831. (*      Fix_Up_File_Name --- Get file name for edit/view operation          *)
  832. (*--------------------------------------------------------------------------*)
  833.  
  834. PROCEDURE Fix_Up_File_Name(      File_Function: AnyStr;
  835.                                  Path         : AnyStr;
  836.                             VAR  Jump_Text    : AnyStr  );
  837. VAR
  838.    FName : FileStr;
  839.    IPos  : INTEGER;
  840.  
  841. BEGIN (* Fix_Up_File_Name *)
  842.                                    (* Save screen *)
  843.  
  844.    Save_Partial_Screen( Saved_Screen, 5, 10, 75, 14 );
  845.  
  846.    Draw_Menu_Frame( 5, 10, 75, 14, Menu_Frame_Color, Menu_Title_Color,
  847.                     Menu_Text_Color, File_Function + ' File');
  848.  
  849.                                    (* Get name of file to edit *)
  850.    FName[0] := CHR( 0 );
  851.  
  852.    WRITELN('Enter name of file to ', File_Function, ':');
  853.    WRITE('>');
  854.    Read_Edited_String( FName );
  855.    WRITELN;
  856.                                    (* Restore screen *)
  857.    Restore_Screen( Saved_Screen );
  858.    Reset_Global_Colors;
  859.                                    (* Replace file name marker in path *)
  860.                                    (* with file name just obtained     *)
  861.  
  862.    IF ( FName <> CHR( ESC ) ) THEN
  863.       BEGIN
  864.  
  865.          Jump_Text := Path;
  866.  
  867.          IPos := POS( '%F' , Jump_Text );
  868.  
  869.          WHILE( IPos > 0 ) DO
  870.             BEGIN
  871.                DELETE( Jump_Text, IPos, 2 );
  872.                INSERT( FName, Jump_Text, IPos );
  873.                IPos := POS( '%F' , Jump_Text );
  874.             END;
  875.  
  876.       END
  877.    ELSE
  878.       Jump_Text[0] := CHR( 0 );
  879.  
  880. END    (* Fix_Up_File_Name *);
  881.  
  882. (*--------------------------------------------------------------------------*)
  883. (*           Allocate_Variable --- Allocate variable if necessary           *)
  884. (*--------------------------------------------------------------------------*)
  885.  
  886. PROCEDURE Allocate_Variable;
  887.  
  888. VAR
  889.    NBytes : INTEGER;
  890.    P      : Script_Save_Variable_Record_Ptr;
  891.  
  892. BEGIN (* Allocate_Variable *)
  893.  
  894. {
  895.    IF Debug_Mode THEN
  896.       Debug_Write('--- Allocating variable # ' + ITOS( Script_Integer_1 ) +
  897.               ' = ' + Script_String + ' of type = ' + ITOS( Script_Integer_2 ) );
  898. }
  899.                                    (* Save previous var at this offset *)
  900.                                    (* if in CALLed procedure           *)
  901.  
  902.    IF ( Script_Call_Depth > 0 ) THEN
  903.       WITH Script_Call_Stack[Script_Call_Depth] DO
  904.          BEGIN
  905.             P := Save_Vars;
  906.             NEW( Save_Vars );
  907.             Save_Vars^.Prev_Var  := P;
  908.             NEW( Save_Vars^.Save_Data );
  909.             Save_Vars^.Save_Data^ := Script_Variables^[Script_Integer_1];
  910.  
  911. {
  912.             IF Debug_Mode THEN
  913.                BEGIN
  914.                   Debug_Write('--- Saving old variable ' + IToS( Script_Integer_1 ) );
  915.                   Debug_Write('                   Name = ' +
  916.                               Script_Variables^[Script_Integer_1].Var_Name );
  917.                   Debug_Write('             Call depth = ' +
  918.                               IToS( Script_Call_Depth ) );
  919.                END;
  920. }
  921.  
  922.          END;
  923.                                    (* Allocate the variable *)
  924.  
  925.    IF ( Command = DeclareSy ) THEN
  926.       WITH Script_Variables^[Script_Integer_1] DO
  927.          BEGIN
  928.  
  929.             CASE Oper_Type_Vector[Script_Integer_2] OF
  930.                Integer_Variable_Type: NBytes := 3;
  931.                String_Variable_Type : NBytes := 256;
  932.                ELSE
  933. {
  934.                   IF Debug_Mode THEN
  935.                      Debug_Write('===> WARNING, Bogus type in allocate = ' +
  936.                                  ITOS( Script_Integer_2 ) );
  937. }
  938.                                       ;
  939.             END (* CASE *);
  940.  
  941.          GETMEM( Var_Value , NBytes );
  942.  
  943.          Var_Value^ := Script_String_2;
  944.          Var_Name   := Script_String;
  945.          Var_Type   := Oper_Type_Vector[Script_Integer_2];
  946.          Var_Passed := FALSE;
  947.  
  948.       END
  949.    ELSE IF ( Command = ImportSy ) THEN
  950.       BEGIN
  951.          Script_Parameter_Got := SUCC( Script_Parameter_Got );
  952.          Script_Variables^[Script_Integer_1] :=
  953.             Prev_Script_Variables^[Script_Parameters^[Script_Parameter_Got]];
  954.          Script_Variables^[Script_Integer_1].Var_Passed := TRUE;
  955.       END
  956.    ELSE (* PImportSy *)
  957.       BEGIN
  958.          Proc_Parameter_Got := SUCC( Proc_Parameter_Got );
  959.          Script_Variables^[Script_Integer_1] :=
  960.             Script_Variables^[Proc_Parameters^[Proc_Parameter_Got]];
  961.          Script_Variables^[Script_Integer_1].Var_Passed := TRUE;
  962.       END;
  963.  
  964.    Script_Variable_Count := MAX( Script_Variable_Count , Script_Integer_1 );
  965.  
  966. END   (* Allocate_Variable *);
  967.  
  968. (*--------------------------------------------------------------------------*)
  969. (*                Zap_Variables --- Zap script variables                    *)
  970. (*--------------------------------------------------------------------------*)
  971.  
  972. PROCEDURE Zap_Script_Variables( First : INTEGER; Last : INTEGER );
  973.  
  974. VAR
  975.    I: INTEGER;
  976.    P: Script_Save_Variable_Record_Ptr;
  977.    V: INTEGER;
  978.  
  979. BEGIN (* Zap_Script_Variables *)
  980.                                    (* Free up variable memory *)
  981.    FOR I := Last DOWNTO First DO
  982.       WITH Script_Variables^[I] DO
  983.          IF ( NOT Var_Passed ) THEN
  984.             CASE Var_Type OF
  985.                Integer_Variable_Type: FREEMEM( Var_Value , 3   );
  986.                String_Variable_Type : FREEMEM( Var_Value , 256 );
  987.                ELSE;
  988.             END;
  989.                                    (* Restore old variable pointers *)
  990.                                    (* if necessary.                 *)
  991.  
  992.    IF ( Script_Call_Depth > 0 ) THEN
  993.       WITH Script_Call_Stack[Script_Call_Depth] DO
  994.          FOR I := Last DOWNTO First DO
  995.             BEGIN
  996.                P := Save_Vars;
  997.                IF ( P <> NIL ) THEN
  998.                   BEGIN
  999.                      Script_Variables^[I] := P^.Save_Data^;
  1000.                      Save_Vars            := P^.Prev_Var;
  1001.                      DISPOSE( P^.Save_Data );
  1002.                      DISPOSE( P );
  1003. {
  1004.                      IF Debug_Mode THEN
  1005.                         BEGIN
  1006.                            Debug_Write('Restoring variable ' + IToS( I ));
  1007.                            Debug_Write('            Name = ' + Script_Variables^[I].Var_Name );
  1008.                            CASE Script_Variables^[I].Var_Type OF
  1009.                               Integer_Variable_Type : BEGIN
  1010.                                                          Debug_Write('            Type = INTEGER' );
  1011.                                                          MOVE( Script_Variables^[I].Var_Value^[1], V, 2 );
  1012.                                                          Debug_Write('           Value = ' + IToS( V ) );
  1013.                                                       END;
  1014.                               String_Variable_Type  : BEGIN
  1015.                                                          Debug_Write('            Type = STRING');
  1016.                                                          Debug_Write('           Value = ' +
  1017.                                                                      Script_Variables^[I].Var_Value^ );
  1018.                                                       END;
  1019.                            END (* CASE *);
  1020.                            Debug_Write('             Call depth = ' +
  1021.                                        IToS( Script_Call_Depth ) );
  1022.                         END;
  1023. }
  1024.                   END;
  1025.             END;
  1026.                                    (* Restore old variable count *)
  1027.  
  1028.    Script_Variable_Count := PRED( First );
  1029. {
  1030.    IF Debug_Mode THEN
  1031.       Debug_Write( 'Zap:  First = ' + IToS( First ) + ', Last = ' +
  1032.                    IToS( Last ) + ', Count = ' + IToS( Script_Variable_Count ) );
  1033. }
  1034. END   (* Zap_Script_Variables *);
  1035.  
  1036. (*--------------------------------------------------------------------------*)
  1037. (*           Clear_Script_Variables --- Deallocate script variables         *)
  1038. (*--------------------------------------------------------------------------*)
  1039.  
  1040. PROCEDURE Clear_Script_Variables;
  1041.  
  1042. VAR
  1043.    I: INTEGER;
  1044.    L: INTEGER;
  1045.    S: AnyStr;
  1046.  
  1047. BEGIN (* Clear_Script_Variables *)
  1048.  
  1049.                                    (* Free space for variable values *)
  1050.  
  1051.    Zap_Script_Variables( 3 , Script_Variable_Count );
  1052.  
  1053.                                    (* Free space for variable pointers *)
  1054.    FREEMEM( Script_Variables ,
  1055.             ( Script_Variable_Count + 3 ) * SizeOf( Script_Variables^[1] ) );
  1056.  
  1057.                                    (* No script variables active *)
  1058.    Script_Variable_Count  := 2;
  1059.    Script_Parameter_Count := 0;
  1060.    Script_Parameter_Got   := 0;
  1061.                                    (* Close all script files           *)
  1062.  
  1063.    FOR I := 1 TO MaxScriptOpenFiles DO
  1064.       IF Script_File_Used[I] THEN
  1065.          BEGIN
  1066.             IF Script_File_List[I]^.Opened THEN
  1067.                BEGIN
  1068.                      (*$I-*)
  1069.                   CLOSE( Script_File_List[I]^.F );
  1070.                      (*$I+*)
  1071.                   L := INT24Result;
  1072.                END;
  1073.             DISPOSE( Script_File_List[I] );
  1074.             Script_File_Used[I] := FALSE;
  1075.          END;
  1076.                                    (* Turn off other script activities *)
  1077.  
  1078.    FOR I := 1 TO Script_Wait_Count DO
  1079.       WITH Script_Wait_List[I] DO
  1080.          BEGIN
  1081.             DISPOSE( Wait_Text  );
  1082.             DISPOSE( Wait_Reply );
  1083.          END;
  1084.  
  1085.    Script_File_Name[0]   := CHR( 0 );
  1086.    Script_Buffer         := NIL;
  1087.    Script_Dialed         := FALSE;
  1088.    Really_Wait_String    := FALSE;
  1089.    WaitString_Mode       := FALSE;
  1090.    Script_File_Count     := 0;
  1091.    Script_Wait_Count     := 0;
  1092.    Script_IO_Error       := 0;
  1093.                                    (* Clear out command line area. *)
  1094.    S := CHR( CR );
  1095.    MOVE( S[0], Mem[CSeg:$80], 2 );
  1096.  
  1097. END   (* Clear_Script_Variables *);
  1098.  
  1099. (*--------------------------------------------------------------------------*)
  1100. (*           Read_Chars --- Read characters from script-defined file        *)
  1101. (*--------------------------------------------------------------------------*)
  1102.  
  1103. PROCEDURE Read_Chars( VAR F        : Text_File;
  1104.                       VAR S        : AnyStr;
  1105.                           N        : INTEGER;
  1106.                       VAR EOF_Seen : BOOLEAN;
  1107.                           Use_KBD  : BOOLEAN );
  1108.  
  1109. VAR
  1110.    I : INTEGER;
  1111.    J : INTEGER;
  1112.    Ch: CHAR;
  1113.  
  1114. BEGIN (* Read_Chars *)
  1115. {
  1116.    IF Debug_Mode THEN
  1117.       BEGIN
  1118.          Write_Log( 'N=' + CHR( ORD('0') + N ), FALSE, FALSE );
  1119.          Write_Log( 'UK=' + CHR( ORD('0') + ORD(Use_KBD) ), FALSE, FALSE );
  1120.       END;
  1121. }
  1122.    IF EOF_Seen THEN
  1123.       S[0] := CHR( 0 )
  1124.    ELSE
  1125.       BEGIN
  1126.  
  1127.          I := 0;
  1128.  
  1129.          WHILE ( ( I < N ) AND ( NOT EOF_Seen ) ) DO
  1130.             BEGIN
  1131.  
  1132.                   (*$I-*)
  1133.                CASE Use_KBD OF
  1134.                   FALSE:  BEGIN
  1135.                              READ( F , Ch );
  1136.                              Script_IO_Error := INT24Result;
  1137.                              EOF_Seen        := EOF( F ) OR ( Ch = ^Z );
  1138.                           END;
  1139.                   TRUE:   BEGIN
  1140.                              READ( Kbd , Ch );
  1141.                              WRITE( Ch );
  1142.                              Script_IO_Error := INT24Result;
  1143.                           END;
  1144.                END (* CASE *);
  1145.                   (*$I+*)
  1146.  
  1147.                IF ( NOT EOF_Seen ) THEN
  1148.                   BEGIN
  1149.                      I    := SUCC( I );
  1150.                      S[I] := Ch;
  1151.                   END;
  1152.  
  1153.             END;
  1154.  
  1155.          S[0] := CHR( I );
  1156.  
  1157.       END;
  1158.  
  1159. END   (* Read_Chars *);
  1160.  
  1161. (*--------------------------------------------------------------------------*)
  1162. (*           Unload_This_Script --- Unload just-executed script             *)
  1163. (*--------------------------------------------------------------------------*)
  1164.  
  1165. PROCEDURE Unload_This_Script;
  1166.  
  1167. VAR
  1168.    I: INTEGER;
  1169.    J: INTEGER;
  1170.  
  1171. BEGIN (* Unload_This_Script *)
  1172.  
  1173.    I := Current_Script_Num;
  1174.  
  1175.    FREEMEM( Scripts[I].Script_Ptr , Scripts[I].Script_Len );
  1176.  
  1177.    FOR J := ( I + 1 ) TO Script_Count DO
  1178.       MOVE( Scripts[J], Scripts[J-1], SizeOf( Scripts[1] ) );
  1179.  
  1180.    Script_Count := PRED( Script_Count );
  1181.  
  1182. END   (* Unload_This_Script *);
  1183.  
  1184. (*--------------------------------------------------------------------------*)
  1185. (*           Exit_All_Scripts --- Exit all scripts regardless of nesting    *)
  1186. (*--------------------------------------------------------------------------*)
  1187.  
  1188. PROCEDURE Exit_All_Scripts;
  1189.  
  1190. VAR
  1191.    I: INTEGER;
  1192.  
  1193. BEGIN (* Exit_All_Scripts *)
  1194.  
  1195.    REPEAT
  1196.                                    (* Free space for variable values *)
  1197.  
  1198.       Zap_Script_Variables( 3 , Script_Variable_Count );
  1199.  
  1200.                                    (* Free space for variable pointers *)
  1201.       FREEMEM( Script_Variables ,
  1202.                ( Script_Variable_Count + 3 ) * SizeOf( Script_Variables^[1] ) );
  1203.  
  1204.                                    (* Free space for any parameters *)
  1205.  
  1206.       IF ( Script_Parameter_Count > 0 ) THEN
  1207.          DISPOSE( Script_Parameters );
  1208.  
  1209.       WITH Script_Stack_Position[Script_Stack_Depth] DO
  1210.          BEGIN
  1211.             Script_Buffer          := Buffer_Ptr;
  1212.             Script_Buffer_Pos      := Buffer_Pos;
  1213.             Current_Script_Num     := Script_Num;
  1214.             Script_Variables       := Vars_Ptr;
  1215.             Script_Variable_Count  := Vars_Count;
  1216.             Script_Parameters      := Params_Ptr;
  1217.             Script_Parameter_Count := Params_Count;
  1218.             Script_Parameter_Got   := Params_Got;
  1219.             Prev_Script_Variables  := Prev_Ptr;
  1220.          END;
  1221.  
  1222.       Script_Stack_Depth := PRED( Script_Stack_Depth );
  1223.  
  1224.    UNTIL ( Script_Stack_Depth = 0 );
  1225.  
  1226.                                    (* Clear top-level scripts stuff *)
  1227.    Clear_Script_Variables;
  1228.                                    (* Indicate script mode turned off *)
  1229.  
  1230.    Toggle_Option( 'Script Mode', Script_File_Mode );
  1231.  
  1232. END   (* Exit_All_Scripts *);
  1233.